home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swaga_c.zip / COMM.SWG / 0073_Uart IO - Modem Opening.pas < prev    next >
Pascal/Delphi Source File  |  1995-03-03  |  14KB  |  489 lines
  1. {
  2. From: Thomas.Fink@User.AenF.WAU.NL
  3.  
  4. >If anyone has ANY source code for Opening and closing and basic
  5. >I/O to Modems.  PLEASE send it to me.
  6.  
  7. You asked for it..............
  8. It's pretty lengthy and comments are in german!  :-)
  9. I did it myself and use it for several years now:
  10.  
  11. File:   V24UART.PAS
  12.  
  13. Typ:    Unit, universell.
  14.  
  15. Autor:  T.Fink
  16.  
  17. Zweck:  Hardwarenaher Zugriff auf die V24-Schnittstelle.
  18.  
  19. Copyr.: Thomas Fink, Graurheindorfer Straße 81, 5300 Bonn 1.
  20.  
  21.   Datum  I Modifikation                                             I durch:
  22. ---------+----------------------------------------------------------+---------
  23. 09.06.89 I Erstellung                                               I TF
  24. 02.02.92 I Header                                                   I
  25. 21.05.93 I COM3 & 4                                                 I
  26. }
  27. unit V24UART;
  28.  
  29. interface
  30.  
  31. uses
  32.   ST,                   { Str80 }
  33.   TIME;                 { StartTicks, ReadTicks, TicksperSecond }
  34.  
  35.  
  36. { Konfiguration der Schnittstelle }
  37. type
  38.   V24Kanal   = ( V24COM1, V24COM2, V24COM3, V24COM4, V24COMNone );
  39.   V24Baud    = ( V24B2, V24B300, V24B1200, V24B2400,
  40.                  V24B4800, V24B9600, V24B19200
  41.                );
  42.   V24Data    = ( V24D5, V24D6, V24D7, V24D8 );
  43.   V24Parity  = ( V24None, V24Odd, V24Even, V24Zero, V24One );
  44.   V24Stop    = ( V24S1, V24S2 );
  45.  
  46.  
  47. { Stati und Fehlermeldungen }
  48. type
  49.   V24Stati    = ( V24RData, V24OverrunErr, V24ParityErr, V24FrameErr,
  50.                   V24Break, V24Bufempty,   V24TFree,     V24X,
  51.                   V24DCTS,  V24DDSR,       V24TRI,       V24DDCD,
  52.                   V24CTS,   V24noDSR,      V24RI,        V24DCD,
  53.                   V24Timeout
  54.                 );
  55.   V24Status   = set of V24Stati;
  56.   V24Controls = ( V24DTR,   V24RTS,        V24Out1,      V24Out2,
  57.                   V24Loop
  58.                 );
  59.   V24Control  = set of V24Controls;
  60.  
  61. function  V24RStat:boolean;                     { ob Zeichen empfangen wurde }
  62. function  V24TStat:boolean;                     { ob Sende.Reg. & H.S. frei }
  63. function  V24RByte:byte;                        { Wartet, bis Ch empfangen }
  64. procedure V24TByte( B:byte );                   { Wartet, bis Ch gesendet }
  65. function  V24ReceiveByte:byte;                  { Bricht mit Timeout ab }
  66. procedure V24TransmitByte( B:byte );            { Bricht mit Timeout ab }
  67. procedure V24Select( K:V24Kanal );              { Wählt Schnittstelle aus }
  68. procedure V24Init( B:V24Baud; D:V24Data; P:V24Parity; S:V24Stop; ds:word );
  69. function  V24Error( var E:V24Status ):boolean;  { ob Fehler aufgetreten ist }
  70. procedure V24SetControl( C:V24Control );        { setzt DTR&CTS               }
  71. function  V24THand:boolean;                     { ob Handshake Senden erlaubt }
  72. procedure V24RHand( B:boolean );                { setzt Handshake für Partner }
  73. procedure V24TBreak;                            { sendet ein Break }
  74. procedure V24Config;                            { interaktive Konfiguration }
  75. function  V24StatusString(S:V24Status):string;  { gibt Status an }
  76. function  V24ErrorString(S:V24Status):Str80;    { nur die Fehler }
  77. procedure V24StatusDump;                        { gibt momentanen Status aus }
  78. function  V24GetDSR:boolean;                    { schneller }
  79. function  V24GetDCD:boolean;
  80.  
  81. var
  82.   V24KanalStatus     : V24Kanal;
  83.  
  84.  
  85. (*
  86.  
  87. Beschreibung der Pins der V24-Schnittstelle:
  88.  
  89. Typ: DTE (Terminal), männlich.
  90.  
  91. DB25 DB9
  92.  Pin Pin Name  Richtung  Verwendung
  93.   2   3  TD    Out       Gesendete Daten
  94.   3   2  RD    In        Empfangene Daten
  95.   4   7  RTS   Out       Handshake, Sendeerlaubnis                      *1
  96.   5   8  CTS   In        Handshake, Empfangsbereitschaft der Gegenseite *2
  97.   6   6  DSR   In        Betriebsbereitschaft der Gegenstelle
  98.   7   5  GND   ---       Erde
  99.   8   1  DCD   In        ---
  100.  20   4  DTR   Out       Betriebsbereitschaft der Software              *3
  101.  
  102. *1 : Diese Leitung kann abweichend von der V24-Norm betrieben werden,
  103.      z.B. um um ein bidirektionales Handshake oder eine Gerätesteuerung
  104.      zu ermoeglichen.
  105. *2 : Ermöglicht die Sendefreigabe innerhalb des UARTs.
  106. *3 : Kann als +12V zum Kurzschließen des Handshakes (CTS,DSR) dienen.
  107. *)
  108.  
  109.  
  110. implementation
  111.  
  112. const
  113.   V24KanalMax     = 3;
  114.   V24BaudMax      = 6;
  115.   V24DataMax      = 3;
  116.   V24ParityMax    = 4;
  117.   V24StopMax      = 1;
  118.  
  119.   V24KanalId    : array[ V24Kanal ] of string[4]
  120.                 = ( 'COM1', 'COM2', 'COM3', 'COM4', 'None' );
  121.   V24BaudId     : array[ V24Baud ] of string[5]
  122.                 = ( '2', '300', '1200', '2400', '4800', '9600', '19200' );
  123.   V24DataId     : array[ V24Data ] of char
  124.                 = ( '5', '6', '7', '8' );
  125.   V24ParityId   : array[ V24Parity ] of string[4]
  126.                 = ( 'none', 'odd', 'even', 'zero', 'one' );
  127.   V24StopId     : array[ V24Stop ] of char
  128.                 = ( '1', '2' );
  129.  
  130.   V24BaudDat    : array[V24Baud] of word
  131.                 = ( 2, 300, 1200, 2400, 4800, 9600, 19200 );
  132.   V24ParityDat : array[V24Parity] of byte
  133.                 = ( 0, 1, 3, 5, 7 );
  134.  
  135.  
  136. { Stati und Fehlermeldungen }
  137.  
  138. const
  139.   V24StatusId     : array[V24Stati] of string[14]
  140.                   = ( 'Data_received',  'Overrun_Error',    { $01, $02 }
  141.                       'Parity_Error',   'Frame_Error',      { $04, $08 }
  142.                       'Break_received', 'Buffer_empty',     { $10, $20 }
  143.                       'Transmit_free',  '',                 { $40, $80 }
  144.                       'CTS_changed',    'DSR_changed',      { $01, $02 }
  145.                       'Ring_started',   'DCD_changed',      { $04, $08 }
  146.                       'CTS',            'noDSR',            { $10, $20 }
  147.                       'Ring',           'DCD',              { $40, $80 }
  148.                       'Timeout'
  149.                     );
  150.   V24ControlId    : array[V24Controls] of string[9]
  151.                   = ( 'DTR', 'RTS', 'IRQ1', 'IRQ2', 'Loop_Mode' );
  152.  
  153.   V24Errors       : V24Status
  154.                   = [ V24FrameErr, V24ParityErr,
  155.                       V24OverrunErr, V24Timeout
  156.                       { V24noDSR }
  157.                     ];
  158.  
  159. {.FF}
  160.  
  161. { Register }
  162. const
  163.   V24PortAdr         : array[ V24Kanal ] of word
  164.                      = ( $3F8, $2F8, $3E8, $2E8, 0 );   { COM1, COM2, COM3,
  165. COM4 }
  166.   V24DataReg         = 0;
  167.   V24IRQEnReg        = 1;
  168.   V24RateLReg        = 0;
  169.   V24RateHReg        = 1;
  170.   V24IRQIdReg        = 2;
  171.   V24ModeReg         = 3;
  172.   V24ModemControlReg = 4;
  173.   V24StatusReg       = 5;
  174.   V24ModemStatusReg  = 6;
  175.   V24ScratchReg      = 7;
  176.  
  177.  
  178. { Software-Status Variablen }
  179. const
  180.   V24Port            : word    = $3F8;
  181.   V24KanalSelected   : boolean = false;
  182. var
  183.   V24PortStatus : record case boolean of
  184.                     true  : ( S : V24Status );
  185.                     false : ( B0,B1,B2 : byte );
  186.                   end;
  187.   V24Timed      : boolean;
  188.   V24TimeOutVal : longint;
  189.   V24TimeOutArr : array[ V24Kanal ] of longint;
  190.   V24Time       : Ticker;
  191.  
  192. {****************************************************************************}
  193.  
  194. { Simple Chipzugriffe }
  195.  
  196. function V24RStat:boolean;   { true wenn Zeichen empfangen }
  197. begin
  198.   V24RStat:= ( port[V24Port+V24StatusReg] and $01 <> 0 );
  199. end;
  200.  
  201. { true wenn Senderegister leer }
  202. function V24TStat:boolean;
  203. begin
  204.   V24TStat:=     ( port[V24Port+V24StatusReg] and $40 <> 0 )
  205. {            and ( port[V24Port+V24ModemStatusReg] and $30 = $30 ) CTS und DSR
  206. }
  207.              ;
  208. end;
  209.  
  210. function V24RByte:byte;             { Wartet, bis Ch empfangen }
  211. begin
  212.   repeat until V24RStat;
  213.   V24RByte:=port[V24Port+V24DataReg];
  214. end;
  215.  
  216. procedure V24TByte(B: byte);        { Wartet, bis Ch gesendet }
  217. begin
  218.   repeat until V24TStat;
  219.   port[V24Port+V24DataReg]:=B;
  220. end;
  221.  
  222. {*****************************************************************************}
  223.  
  224. var
  225.   I : integer;
  226.  
  227. function V24ReceiveByte:byte;          { Bricht mit Timeout ab }
  228. begin
  229.   for I:=1 to 1000 do                  { bei hohen Baudraten notwendig }
  230.     if V24RStat then
  231.       begin
  232.         V24ReceiveByte:= port[ V24Port + V24DataReg ];
  233.         exit;
  234.       end
  235.     ;
  236.   ;
  237.  
  238.   StartTicker( V24Time );
  239.   while not V24RStat do
  240.     if ReadTicker( V24Time )>V24TimeOutVal then    { 20 us }
  241.       begin
  242.         V24Timed:=true;
  243.         V24ReceiveByte:=0;
  244.         exit;
  245.       end
  246.     ;
  247.   ;
  248.   V24ReceiveByte:= port[V24Port+V24DataReg];
  249. end;
  250.  
  251. procedure V24TransmitByte(B: byte);    { Bricht mit Timeout ab }
  252. begin
  253.   for I:=1 to 1000 do
  254.     if V24TStat then
  255.       begin
  256.         port[V24Port+V24DataReg]:=B;
  257.         exit;
  258.       end
  259.     ;
  260.   ;
  261.  
  262.   StartTicker( V24Time );
  263.   while not V24TStat do
  264.     if ReadTicker( V24Time )>V24TimeOutVal then
  265.       begin
  266.         V24Timed:=true;
  267.         exit;
  268.       end
  269.     ;
  270.   ;
  271.   port[V24Port+V24DataReg]:=B;
  272. end;
  273.  
  274. {****************************************************************************}
  275.  
  276. procedure V24Select( K:V24Kanal );
  277. begin
  278.   if K=V24COMNone then exit;
  279.   V24KanalStatus:=K;
  280.   V24Port:=V24PortAdr[ K ];
  281.   V24TimeOutVal:=V24TimeOutArr[ K ];
  282.   V24KanalSelected:=true;
  283. end;
  284.  
  285.  
  286.  
  287. {
  288.   Initialisieren der Baudrate, der Datenbitzahl, der Parität, der Stopbitzahl
  289.   und der Zeit in 1/10 sec, die die Receive- &Transmit-routinen warten dürfen.
  290. }
  291. procedure V24Init( B:V24Baud; D:V24Data; P:V24Parity; S:V24Stop; ds:word );
  292. const
  293.   V24Clock = 115200;  { 1843200/16 Hertz  Quarztakt }
  294. var
  295.   Rate : word;
  296.   Data : byte;
  297. begin
  298.   if not V24KanalSelected then
  299.     begin
  300.       writeln( 'V24Kanal nicht selektiert!' ); halt;
  301.     end
  302.   ;
  303.  
  304.   V24Timed:=false;
  305.   V24TimeOutVal:=(longint(ds) * 18) div 10;
  306.   V24TimeOutArr[ V24KanalStatus ] := V24TimeOutVal;
  307.  
  308.   port[V24Port+V24ModeReg]:=$80;               { select Rate Register }
  309.   Rate := V24Clock div V24BaudDat[B];
  310.   port[V24Port+V24RateLReg] := lo(Rate);
  311.   port[V24Port+V24RateHReg] := hi(Rate);
  312.   port[V24Port+V24ModeReg]  :=    ord(D)
  313.                                or ord(S) shl 2
  314.                                or V24ParityDat[P] shl 3
  315.                                ;
  316.   port[V24Port+V24IRQEnReg] := 0;
  317.   port[V24Port+V24ModemControlReg]:= $01; { DTR };
  318.   port[V24Port+V24StatusReg]:= 0;
  319.   Data:=port[V24Port+V24DataReg];
  320. end;
  321.  
  322. function V24Error(var E:V24Status):boolean;
  323. var
  324.   B    : boolean;
  325.   Data : byte;
  326. begin
  327.   V24PortStatus.B0 := port[ V24Port+V24StatusReg ];
  328.   V24PortStatus.B1 := port[ V24Port+V24ModemStatusReg ] xor $20; { inv DSR }
  329.   V24PortStatus.B2 := ord( V24Timed );
  330.   V24Timed := false;
  331.   E        := V24PortStatus.S;
  332.   B        := ( E * V24Errors <> [] );
  333.   if B then Data:=port[ V24Port+V24DataReg ];
  334.   V24Error := B;
  335. end;
  336.  
  337. function V24GetDSR:boolean;
  338. begin
  339.   V24GetDSR:=(  port[ V24Port+V24ModemStatusReg ] and $20 )>0;
  340. end;
  341.  
  342. function V24GetDCD:boolean;
  343. begin
  344.   V24GetDCD:=(  port[ V24Port+V24ModemStatusReg ] and $80 )>0;
  345. end;
  346.  
  347. {****************************************************************************}
  348.  
  349. procedure V24SetControl( C:V24Control );        { setzt DTR&CTS               }
  350. begin
  351.   port[ V24Port+V24ModemControlReg ] := byte( C );
  352. end;
  353.  
  354. function V24THand:boolean;
  355. begin
  356.   V24THand:=( port[V24Port+V24ModemStatusReg] and $30 = $30 );
  357.   { V24DSR, V24CTS }
  358. end;
  359.  
  360. procedure V24RHand(B:boolean);                { Pin 5 }
  361. begin
  362.   if B
  363.   then V24SetControl( [ V24DTR, V24RTS ] )
  364.   else V24SetControl( [ V24DTR ] )
  365.   ;
  366. end;
  367.  
  368. procedure V24TBreak;
  369. begin
  370.   port[V24Port+V24ModeReg] := port[V24Port+V24ModeReg] or $40;
  371.   V24TByte(0);
  372.   port[V24Port+V24ModeReg] := port[V24Port+V24ModeReg] and $BF;
  373. end;
  374.  
  375. {****************************************************************************}
  376.  
  377. procedure V24Config;
  378. var
  379.   H,I,J,K,L : byte;
  380.   T         : word;
  381. begin
  382.  
  383.   repeat
  384.     writeln; writeln( 'V24-Kanal:' );
  385.     for H:=0 to V24KanalMax do
  386.       writeln( succ( H ), ') ', V24KanalId[ V24Kanal( H ) ] )
  387.     ;
  388.     write( 'Ihre Wahl? ' );  readln( H );
  389.   until ( H>0 ) and ( H<=succ(V24KanalMax) );
  390.  
  391.   repeat
  392.     writeln; writeln( 'V24-Baudrate:' );
  393.     for I:=0 to V24BaudMax do
  394.       writeln( succ(I), ') ', V24BaudId[V24Baud(I)] )
  395.     ;
  396.     write( 'Ihre Wahl? ' );  readln(I);
  397.   until (I>0) and ( I<=succ(V24BaudMax) );
  398.  
  399.   repeat
  400.     writeln; writeln( 'V24-Datenbits:' );
  401.     for J:=0 to V24DataMax do
  402.       writeln(succ(J), ') ', V24DataId[V24Data(J)] )
  403.     ;
  404.     write('Ihre Wahl? ');  readln(J);
  405.   until (J>0) and ( J<=succ(V24DataMax) );
  406.  
  407.   repeat
  408.     writeln; writeln('V24-Parity:');
  409.     for K:=0 to V24ParityMax do
  410.       writeln(succ(K), ') ', V24ParityId[V24Parity(K)] )
  411.     ;
  412.     write('Ihre Wahl? ');  readln(K);
  413.   until (K>0) and ( K<=succ(V24ParityMax) );
  414.  
  415.   repeat
  416.     writeln; writeln('V24-Stopbits:');
  417.     for L:=0 to V24StopMax do
  418.       writeln(succ(L), ') ', V24StopId[V24Stop(L)] )
  419.     ;
  420.     write('Ihre Wahl? ');  readln(L);
  421.   until (L>0) and ( L<=succ(V24StopMax) );
  422.  
  423.   repeat
  424.     writeln; writeln( 'V24-Timeout Zeit (0s..6500s)' );
  425.     write( 'Zeit in 1/10 Sekunden? ' );
  426.     readln( T );
  427.   until T<=6500;
  428.  
  429.   V24Select( V24Kanal( pred( H ) ) );
  430.   V24Init( V24Baud(pred(I)), V24Data(pred(J)),
  431.            V24Parity(pred(K)), V24Stop(pred(L)),
  432.            T
  433.          );
  434.  
  435. end;
  436.  
  437. function V24StatusString(S:V24Status):string;
  438. var
  439.   T : string;
  440.   F : V24Stati;
  441. begin
  442.   T:='Error: ';
  443.   if (S*V24Errors<>[]) then T:='Error!' else T:='OK.';
  444.   T:='  Flags:';
  445.   for F:=V24RData to V24Timeout do
  446.     if F in S then
  447.       T:=T+' '+V24StatusId[F]
  448.     ;
  449.   ;
  450.   V24StatusString:=T;
  451. end;
  452.  
  453. function V24ErrorString(S:V24Status):Str80;
  454. var
  455.   T : Str80;
  456.   F : V24Stati;
  457. begin
  458.   S:=S*V24Errors;
  459.   T:='';
  460.   for F:=V24OverrunErr to V24Timeout do
  461.     if F in S then
  462.       T:=T+' '+V24StatusId[F]
  463.     ;
  464.   ;
  465.   V24ErrorString:=T;
  466. end;
  467.  
  468. procedure V24StatusDump;
  469. var
  470.   H : boolean;
  471.   S : V24Status;
  472. begin
  473.   H:=V24Error(S);
  474.   writeln( V24StatusString(S) );
  475. end;
  476.  
  477. procedure Test;
  478. var
  479.   B : byte;
  480. begin
  481.   V24Select( V24COM1 );
  482.   V24Init( V24B19200, V24D8, V24None, V24S1, 100 );   { 9.78sec }
  483.   write( 'OK? ' ); readln;
  484.   B:=V24ReceiveByte;
  485.   writeln( 'Fertig!' );
  486. end;
  487.  
  488. end. { V24UART.PAS }
  489.